home *** CD-ROM | disk | FTP | other *** search
/ Internet Surfer: Getting Started / Internet Surfer - Getting Started (Wayzata Technology)(7231)(1995).bin / pc / mac / bonus / peter_le / finger-1 / my_units / mysystem.uni < prev    next >
Text File  |  1992-02-24  |  5KB  |  207 lines
  1. unit MySystem7;
  2.  
  3. { This code is part of the Finger/Fingerd source code, written in THINK Pascal 4 }
  4. { Copyright 1991-1992 Peter N Lewis }
  5. { If you use this code, you must give me credit in your about box and documentation }
  6. { This is part of my generic library of routines }
  7.  
  8. interface
  9.  
  10. {Note:  InitUtilities must be called prior to using functions marked * in this file }
  11. {            (It is normally called by InitMainLoop in MyMainLoop.unit) }
  12.  
  13.     uses
  14.         AppleTalk, Aliases, PPCToolBox, Processes, EPPC, Notification, AppleEvents;
  15.  
  16.     function MyResolveAliasFile (var vrn: integer; var dirID: longInt; var fname: str63): OSErr; { * }
  17.     function MyFindFolder (vrn: INTEGER; folder: OSType; var ovrn: INTEGER; var oDirID: LONGINT): OSErr; { * }
  18.     function MyInteractWithUser (idleproc: Ptr): OSErr; { * }
  19.     function MyGetAPPL (sig: OSType; var vrn: integer; var dirID: longInt; var fname: str63): OSErr; { * }
  20.     function GetPSN (signature: OSType; var process: ProcessSerialNumber): boolean;
  21.     procedure QuitApplication (creator: OSType);
  22.     procedure SegmentSystem7;
  23.  
  24. implementation
  25.  
  26.     uses
  27.         MyUtils, MyUtilities, MyNotifier, Folders;
  28.  
  29.     const
  30.         pref_folder = 'Preferences';
  31.  
  32. {$S System7}
  33.     procedure SegmentSystem7;
  34.     begin
  35.     end;
  36.  
  37. {$S System7}
  38.     function MyResolveAliasFile (var vrn: integer; var dirID: longInt; var fname: str63): OSErr;
  39.         var
  40.             fs: FSSpec;
  41.             isfolder, wasalias: boolean;
  42.             oe: OSErr;
  43.     begin
  44.         if system7 then begin
  45.             with fs do begin
  46.                 vRefNum := vrn;
  47.                 parID := dirID;
  48.                 name := fname;
  49.                 oe := ResolveAliasFile(fs, true, isfolder, wasalias);
  50.                 if oe = noErr then begin
  51.                     vrn := vRefNum;
  52.                     dirID := parID;
  53.                     fname := name;
  54.                 end;
  55.             end;
  56.         end
  57.         else
  58.             oe := noErr;
  59.         MyResolveAliasFile := oe;
  60.     end;
  61.  
  62. {$S Init}
  63.     function MyFindFolder (vrn: INTEGER; folder: OSType; var ovrn: INTEGER; var oDirID: LONGINT): OSErr;
  64.         var
  65.             oe: OSErr;
  66.             name: str255;
  67.             prefDirID: longInt;
  68.             pb: HParamBlockRec;
  69.     begin
  70.         if system7 then begin
  71.             oe := FindFolder(vrn, folder, true, ovrn, oDirID);
  72.         end
  73.         else begin
  74.             oe := GetDirID(sysenv.sysVRefNum, ovrn, oDirID);
  75.             if (oe = noErr) and (folder = kPreferencesFolderType) then begin
  76.                 name := pref_folder;
  77.                 oe := DirCreate(ovrn, oDirID, name, prefDirID);
  78.                 if oe = noErr then
  79.                     oDirID := prefDirID
  80.                 else begin
  81.                     with pb do begin
  82.                         ioNamePtr := @name;
  83.                         ioVRefNum := ovrn;
  84.                         ioDirID := oDirID;
  85.                         ioFDirIndex := 0;
  86.                     end;
  87.                     oe := PBGetCatInfo(@pb, false);
  88.                     if oe = noErr then
  89.                         oDirID := pb.ioDirID;
  90.                 end;
  91.                 oe := noErr;
  92.             end;
  93.         end;
  94.         MyFindFolder := oe;
  95.     end;
  96.  
  97. {$S System7}
  98.     function MyInteractWithUser (idleproc: Ptr): OSErr;
  99.         var
  100.             oe: OSErr;
  101.     begin
  102.         if system7 then
  103.             oe := AEInteractWithUser(maxLongInt, nil, idleproc)
  104.         else begin
  105.             if in_foreground then
  106.                 MyInteractWithUser := noErr
  107.             else begin
  108.                 Notify(true, true, 128, 0, 0, 0);
  109. { Should wait til we are in the foreground, but its too messy }
  110.             end;
  111.         end;
  112.     end;
  113.  
  114. {$S System7}
  115.     function MyGetAPPL (sig: OSType; var vrn: integer; var dirID: longInt; var fname: str63): OSErr;
  116.         var
  117.             i: integer;
  118.             pbdt: DTPBRec;
  119.             crdate: longInt;
  120.             oe: OSErr;
  121.             found: boolean;
  122.     begin
  123.         found := false;
  124.         if system7 then begin
  125.             i := 1;
  126.             repeat
  127.                 vrn := 0;
  128.                 oe := GetVolInfo(fname, vrn, i, crdate);
  129.                 i := i + 1;
  130.                 if oe = noErr then begin
  131.                     with pbdt do begin
  132.                         fname := '';
  133.                         ioNamePtr := @fname;
  134.                         ioVRefNum := vrn;
  135.                         oe := PBDTGetPath(@pbdt);
  136.                         if oe = noErr then begin
  137.                             ioIndex := 0;
  138.                             ioFileCreator := sig;
  139.                             oe := PBDTGetAPPLSync(@pbdt);
  140.                             if oe = noErr then
  141.                                 found := true;
  142.                         end;
  143.                     end;
  144.                     oe := noErr;
  145.                 end;
  146.             until found or (oe <> noErr);
  147.         end;
  148.         if found then begin
  149.             oe := noErr;
  150.             dirID := pbdt.ioAPPLParID;
  151.         end
  152.         else begin
  153.             oe := afpItemNotFound;
  154.             vrn := 0;
  155.             dirID := 2;
  156.             fname := '';
  157.         end;
  158.         MyGetAPPL := oe;
  159.     end;
  160.  
  161. {$S System7}
  162.     function GetPSN (signature: OSType; var process: ProcessSerialNumber): boolean;
  163.         var
  164.             info: ProcessInfoRec;
  165.             s: str63;
  166.             fs: FSSpec;
  167.             oe: OSErr;
  168.             gv: longInt;
  169.     begin
  170.         GetPSN := false;
  171.         if (Gestalt(gestaltOSAttr, gv) = noErr) & (BTST(gv, gestaltLaunchControl)) then begin
  172.             process.highLongOfPSN := 0;
  173.             process.lowLongOfPSN := kNoProcess;
  174.             info.processInfoLength := sizeof(ProcessInfoRec);
  175.             info.processName := @s;
  176.             info.processAppSpec := @fs;
  177.             while GetNextProcess(process) = noErr do begin
  178.                 if GetProcessInformation(process, info) = noErr then
  179.                     if (info.processType = longInt('APPL')) and (info.processSignature = signature) then begin
  180.                         GetPSN := true;
  181.                         leave;
  182.                     end;
  183.             end;
  184.         end;
  185.     end;
  186.  
  187. {$S System7}
  188.     procedure QuitApplication (creator: OSType);
  189.         var
  190.             process: processSerialNumber;
  191.             infoRec: processInfoRec;
  192.             targetAddress: AEAddressDesc;
  193.             AEvent, AReply: AppleEvent;
  194.             fs: FSSpec;
  195.             oe: OSErr;
  196.     begin
  197.         if GetPSN(creator, process) then begin
  198.             oe := AECreateDesc(typeProcessSerialNumber, @process, SizeOf(process), targetAddress);
  199.             oe := AECreateAppleEvent(kCoreEventClass, kAEQuitApplication, targetAddress, kAutoGenerateReturnID, kAnyTransactionID, AEvent);
  200.             oe := AEDisposeDesc(targetAddress);
  201.             oe := AESend(AEvent, AReply, kAENoReply, kAEHighPriority, 5 * 60, nil, nil);
  202.             oe := AEDisposeDesc(AEvent);
  203.             oe := AEDisposeDesc(AReply);
  204.         end;
  205.     end;
  206.  
  207. end.